home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / amigaunits / amigalib.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-22  |  5KB  |  196 lines
  1. {
  2.     This file is part of the Free Pascal run time library.
  3.  
  4.     A file in Amiga system run time library.
  5.     Copyright (c) 1998 by Nils Sjoholm
  6.     member of the Amiga RTL development team.
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16.  
  17. unit amigalib;
  18.  
  19. INTERFACE
  20.  
  21. uses exec;
  22.  
  23. {*  Exec support functions from amiga.lib  *}
  24.  
  25. procedure BeginIO (ioRequest: pIORequest);
  26. function CreateExtIO (port: pMsgPort; size: Longint): pIORequest;
  27. procedure DeleteExtIO (ioReq: pIORequest);
  28. function CreateStdIO (port: pMsgPort): pIOStdReq;
  29. procedure DeleteStdIO (ioReq: pIOStdReq);
  30. function CreatePort (name: STRPTR; pri: integer): pMsgPort;
  31. procedure DeletePort (port: pMsgPort);
  32. function CreateTask (name: STRPTR; pri: longint; 
  33.                      initPC : Pointer;
  34.              stackSize : ULONG): pTask; 
  35. procedure DeleteTask (task: pTask);
  36. procedure NewList (list: pList);
  37.  
  38. IMPLEMENTATION
  39.  
  40. {*  Exec support functions from amiga.lib  *}
  41.  
  42. procedure BeginIO (ioRequest: pIORequest);
  43. begin
  44.    asm
  45.       move.l  a6,-(a7)
  46.       move.l  ioRequest,a1    ; get IO Request
  47.       move.l  20(a1),a6      ; extract Device ptr
  48.       jsr     -30(a6)        ; call BEGINIO directly
  49.       move.l  (a7)+,a6
  50.    end;
  51. end;
  52.  
  53. function CreateExtIO (port: pMsgPort; size: Longint): pIORequest;
  54. var
  55.    IOReq: pIORequest;
  56. begin
  57.     IOReq := NIL;
  58.     if port <> NIL then
  59.     begin
  60.         IOReq := AllocMem(size, MEMF_CLEAR or MEMF_PUBLIC);
  61.         if IOReq <> NIL then
  62.         begin
  63.             IOReq^.io_Message.mn_Node.ln_Type   := NT_REPLYMSG;
  64.             IOReq^.io_Message.mn_Length    := size;
  65.             IOReq^.io_Message.mn_ReplyPort := port;
  66.         end;
  67.     end;
  68.     CreateExtIO := IOReq;
  69. end;
  70.  
  71.  
  72. procedure DeleteExtIO (ioReq: pIORequest);
  73. begin
  74.     if ioReq <> NIL then
  75.     begin
  76.         ioReq^.io_Message.mn_Node.ln_Type := $FF;
  77.         ioReq^.io_Message.mn_ReplyPort    := pMsgPort(-1);
  78.         ioReq^.io_Device                  := pDevice(-1);
  79.         ExecFreeMem(ioReq, ioReq^.io_Message.mn_Length);
  80.     end
  81. end;
  82.  
  83.  
  84. function CreateStdIO (port: pMsgPort): pIOStdReq;
  85. begin
  86.     CreateStdIO := pIOStdReq(CreateExtIO(port, sizeof(tIOStdReq)))
  87. end;
  88.  
  89.  
  90. procedure DeleteStdIO (ioReq: pIOStdReq);
  91. begin
  92.     DeleteExtIO(pIORequest(ioReq))
  93. end;
  94.  
  95.  
  96. function CreatePort (name: STRPTR; pri: integer): pMsgPort;
  97. var
  98.    port   : pMsgPort;
  99.    sigbit : shortint;
  100. begin
  101.     port  := NIL;
  102.     sigbit := AllocSignal(-1);
  103.     if sigbit <> -1 then
  104.     begin
  105.         port := AllocMem(sizeof(tMsgPort), MEMF_CLEAR or MEMF_PUBLIC);
  106.         if port = NIL then
  107.             FreeSignal(sigbit)
  108.         else
  109.             begin
  110.                 port^.mp_Node.ln_Name  := name;
  111.                 port^.mp_Node.ln_Pri   := pri;
  112.                 port^.mp_Node.ln_Type  := NT_MSGPORT;
  113.  
  114.                 port^.mp_Flags    := PA_SIGNAL;
  115.                 port^.mp_SigBit   := sigbit;
  116.                 port^.mp_SigTask  := FindTask(NIL);
  117.  
  118.                 if name <> NIL then
  119.                     AddPort(port)
  120.                 else
  121.                     NewList(@port^.mp_MsgList);
  122.             end;
  123.     end;
  124.     CreatePort := port;
  125. end;
  126.  
  127.  
  128. procedure DeletePort (port: pMsgPort);
  129. begin
  130.     if port <> NIL then
  131.     begin
  132.         if port^.mp_Node.ln_Name <> NIL then
  133.             RemPort(port);
  134.  
  135.         port^.mp_SigTask       := pTask(-1);
  136.         port^.mp_MsgList.lh_Head  := pNode(-1);
  137.         FreeSignal(port^.mp_SigBit);
  138.         ExecFreeMem(port, sizeof(tMsgPort));
  139.     end;
  140. end;
  141.  
  142.  
  143. function CreateTask (name: STRPTR; pri: longint;
  144.         initPC: pointer; stackSize: ULONG): pTask;
  145. var
  146.    memlist : pMemList;
  147.    task    : pTask;
  148.    totalsize : Longint;
  149. begin
  150.     task  := NIL;
  151.     stackSize   := (stackSize + 3) and not 3;
  152.     totalsize := sizeof(tMemList) + sizeof(tTask) + stackSize;
  153.  
  154.     memlist := AllocMem(totalsize, MEMF_PUBLIC + MEMF_CLEAR);
  155.     if memlist <> NIL then begin
  156.        memlist^.ml_NumEntries := 1;
  157.        memlist^.ml_ME[0].me_Un.meu_Addr := Pointer(memlist + 1);
  158.        memlist^.ml_ME[0].me_Length := totalsize - sizeof(tMemList);
  159.  
  160.        task := pTask(memlist + sizeof(tMemList) + stackSize);
  161.        task^.tc_Node.ln_Pri := pri;
  162.        task^.tc_Node.ln_Type := NT_TASK;
  163.        task^.tc_Node.ln_Name := name;
  164.        task^.tc_SPLower := Pointer(memlist + sizeof(tMemList));
  165.        task^.tc_SPUpper := Pointer(task^.tc_SPLower + stackSize);
  166.        task^.tc_SPReg := task^.tc_SPUpper;
  167.  
  168.        NewList(@task^.tc_MemEntry);
  169.        AddTail(@task^.tc_MemEntry,@memlist^.ml_Node);
  170.  
  171.        AddTask(task,initPC,NIL) 
  172.     end;
  173.     CreateTask := task;
  174. end;
  175.  
  176.  
  177. procedure DeleteTask (task: pTask);
  178. begin
  179.     RemTask(task)
  180. end;
  181.  
  182.  
  183. procedure NewList (list: pList);
  184. begin
  185.     with list^ do
  186.     begin
  187.         lh_Head     := pNode(@lh_Tail);
  188.         lh_Tail     := NIL;
  189.         lh_TailPred := pNode(@lh_Head)
  190.     end
  191. end;
  192.  
  193. end.
  194.  
  195.  
  196.